perm filename FILT2.F4[IRC,LCS] blob sn#153752 filedate 1977-03-30 generic text, type T, neo UTF8
00100	C****** PROGRAMMED "FILTER"
00200	
00300		SUBROUTINE SUBR
00400	 	COMMON /INS/ INST(27),BG(60)
00500		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
00600	C   INST=INSTRUMENT NAME,  BG=BEGIN TIME OF EACH INST.
00700	C   INUM=INST#  IPAR=PARAM#  BT=BASIC TIME P1  WHEN SUBROUTINE IS
00800	C   CALLED, IF IREST IS <0, THAT NOTE WILL BE A REST.
00900	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  F1=86
01000	C   F15=100 (NO F16!)
01100	
01200		DIMENSION A(30)
01210		DATA SPRD/.5/
01300	
01400		IF(INUM.NE.1)GO TO 3
01500	5	I=P(3)
01600		X=I
01700	C  THIS GETS RID OF TRAILING DECIMALS IF RAND SELECTION!
01800	
01900		IF(I.NE.N)GO TO 4
02000	C SKIP IF NO REPTITION
02100		P(3)=P(3)+1
02200	C MOVES UP HALF STEP
02300		GO TO 5
02400	C GO BACK AND PUT IT AWAY AGAIN.
02500	4	N=I
02600	C  SAVE IT FOR NEXT TIME AROUND.
02700	
02710		IF(N.EQ.56)P(5)=86
02720	C  USE FUNCTION F1 WHEN G IS HIT
02730	
02740		X=30.868*2**(X/12)
02770	C  X=FREQ. IN HZ. BASED ON NOTE NUM. IN P3.
02785	
02800		Q=0
02900		IF(N.LT.P(8).OR.N.GT.P(9).OR.P(7).EQ.0)RETURN
03000	C  RETURN IF NOTHING SPECIAL TO BE DONE
03100	
03110		SPRD=SPRD+.5
03120		P(2)=P(2)*SPRD
03130	C  P2 WILL GET SPREAD MORE EACH TIME
03140	
03200		Q=P(7)
03300		P(5)=86
03400	C STORE AWAY P7, CHANGE ENV. TO SOSTENUTO.
03900	
04000		RETURN
04100	
04150	3	IF(P(1).GT.0)IREST=-1
04175	C  THE REST FLAG
04200	
04210		IF(Q.NE.0)GO TO 10
04220	C JUMP IF WE HIP SPECIAL AREA
04230	
04300	C  HARM. 1 (IN P4 AND P5) WON'T CHANGE
04400	C  ALL OTHERS CAN.
04500		DO 1 K=7,19,2
04600		Y=X*P(K-1)
04700	C  GETS TRUE FREQ. OF EACH HARMONIC
04800	
04900		IF(Y.LT.3800)GO TO 1
05000	C  IF IT IS LESS THAN 3800 DON'T WORRY ABOUT IT.
05100	
05200		Y=(4600-Y)/800
05300	C   WHAT PERCENTAGE OF THE DIST. TO 4600 IS IT?
05400	
05500		IF(Y.LT.0)Y=0
05600	C  IF IT IS OVER 4600 WIPE OUT THIS HARMONIC.
05700	
05800		P(K)=P(K)*Y
05900	C  SCALE THIS HARMONIC ACCORDINGLY
06500	
06600	1	CONTINUE
06650	
06700		GO TO 9
06800	C NOTHING MORE TO BE DONE HERE.
06900	
07100	10	P(18)=33
07200		P(16)=25
07300		P(14)=17
07400	C CHANGE HARMS 6,7,8 TO 19,21,23
07500	
07600		P(19)=2
07700		P(17)=2
07800		P(15)=2
07810	
07820	9	DO 6 K=7,19,2
07830		IF(P(K).EQ.A(K))GO TO 6
07840		IREST=0
07850	C IF DIFFERENT VALUE FOR ANY HARM. AMPL. TURN OFF REST FLAG.
07860	6	A(K)=P(K)
07870	C  STORE THIS HARM'S AMPL. FOR THE NEXT TIME.
08000		RETURN
08100		END
08200	
08300	C TYPICAL INPUT FOR "FILTER" ROUTINE.
08400	C FILT 
08500	C TOOT 0 10;
08600	C P2 .1;
08700	C P3 MOV/3 C1,G3  G3,G7/ 2 C5,A C,A/ 1.5 C,A G2,E3;
08750	C 3.5 C2,A6 C2,A6*;
08800	C P4 1000/P5 F2/P6 F3;
08900	C P10 1;
08950	C P7 MO/1 0 0/ 2  1 1/ 5.2  0 0/ 1.5  1 1*;
08975	C P8 MO/8.2 C3 C/ 1.5 C4,C2*;
08987	C P9 MO/8.2 C4,C/ 1.5 C4,A6*;
09000	C END;
09100	
09200	C DUMMY INVIS 0 10;
09300	C P2 P2;
09400	C P3 "SYNTH(F3);";
09500	C P4 1;
09600	C P5 1;
09700	C P6 2;
09800	C P7 1;
09900	C P8 3/  P9 1/  P10 4/  P11 1;
10000	C P12 5/ P13 1/ P14 6/ P15 1/ P16 7/ P17 1;
10100	C P18 8/ P19 1/ P20 SUBN 999/END;